home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_075 / dum2 / src / dudir.mod < prev    next >
Text File  |  1992-05-06  |  7KB  |  240 lines
  1. IMPLEMENTATION MODULE DuDir;
  2.  
  3. (*$S-,$T-,$A+*)
  4.  
  5. (* MODULE to read the directory of a current device or directory and
  6.    place names/sizes into DirTable  - also to Sort them in alphabetical
  7.    order (case insensitive)
  8. *)
  9.  
  10. FROM SYSTEM             IMPORT  NULL,TSIZE,BYTE,ADR;
  11. FROM Strings            IMPORT  InitStringModule, Assign, Length, Copy,Concat;
  12. FROM Conversions        IMPORT  ConvertToString;
  13. FROM Memory             IMPORT  MemReqSet, MemPublic,MemClear, AllocMem,
  14.                                 FreeMem;
  15. FROM DOSFiles           IMPORT  Lock, Unlock, Examine, ExNext, FileLock,
  16.                                 FileInfoBlock, FileInfoBlockPtr;
  17. FROM Intuition          IMPORT  PrintIText, IntuitionText;
  18. FROM DuWindow           IMPORT  DuWindowPtr,WBColors,JamTwo,ResetSlider;
  19.  
  20. (* all these are importable
  21. CONST
  22.   MaxMax                = 300; (* Change this to allow more/less files   *)
  23.                                (* Be warned it uses mucho runtime memory *)
  24.                                (* 300 is enough even for my M2: directory*)
  25. TYPE
  26.   DirInfo       = RECORD
  27.                     FileName    : ARRAY[0..30] OF CHAR;
  28.                     IsDir       : BOOLEAN;
  29.                     IsSelected  : BOOLEAN;
  30.                     WasSelected : BOOLEAN;  (* for future RETAG addition *)
  31.                     FileSize    : LONGCARD;
  32.                   END;
  33.   DirPtr        = POINTER TO DirInfo;
  34. *)
  35.  
  36. TYPE
  37.   CharPtr       = POINTER TO CHAR;
  38.  
  39. VAR
  40. (* local variables *)
  41.   fib           : FileInfoBlockPtr;
  42.   lock          : FileLock;
  43. (* Importable variables in .def file
  44.   DirEntries    : CARDINAL;
  45.   FileText      : IntuitionText;
  46.  
  47.     (* This table is full of pointers to allocated memory for storing
  48.        directory entries   *)
  49.  
  50.   DirTable      : ARRAY[0..MaxMax] OF DirPtr;
  51.   MaxFiles      : CARDINAL;
  52. *)
  53. (* INTERNAL CONSTANT *)
  54. CONST
  55.   MaxScreenFiles        = 15;
  56.  
  57. (*--------------------*)
  58.  
  59. PROCEDURE ReadDirectory(lock:FileLock):BOOLEAN;
  60. VAR good:BOOLEAN;
  61. (* Returns true if good read
  62.  
  63.    DirTable[0] contains the directory record and name.
  64.    DirTable[1] - DirTable[DirEntries] contains filenames & other info *)
  65.  
  66. BEGIN
  67.   fib := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic});
  68.   IF (fib = NULL) THEN RETURN FALSE END;
  69.   IF Examine(lock,fib^) AND (fib^.fibDirEntryType > 0) THEN
  70.     DirEntries := 0;
  71.     REPEAT
  72.       WITH fib^ DO
  73.         Assign(DirTable[DirEntries]^.FileName,fibFileName);
  74.         DirTable[DirEntries]^.IsDir      := (fibDirEntryType > 0);
  75.         DirTable[DirEntries]^.FileSize   := fibSize;
  76.         DirTable[DirEntries]^.WasSelected := FALSE;
  77.         DirTable[DirEntries]^.IsSelected  := FALSE;
  78.       END;
  79.       INC(DirEntries);
  80.     UNTIL (ExNext(lock,fib^) = FALSE) OR (DirEntries > MaxFiles);
  81.     good := TRUE;
  82.     DEC(DirEntries);
  83.   ELSE
  84.     good := FALSE;
  85.   END;
  86.   FreeMem(fib,TSIZE(FileInfoBlock));
  87.   RETURN good;
  88. END ReadDirectory;
  89.  
  90. (*------------*)
  91.  
  92. PROCEDURE FirstHigher (VAR lower,upper : ARRAY OF CHAR): BOOLEAN;
  93. (* Compare dirtable entries filename part      *)
  94. VAR i : CARDINAL;
  95.  BEGIN
  96.   FOR i := 0 TO 30 DO
  97.         (* Test end-of-string cases *)
  98.     IF (upper[i] = 0C) THEN
  99.       IF (lower[i] = 0C) THEN RETURN FALSE ELSE RETURN TRUE END
  100.     ELSIF (lower[i] = 0C) THEN
  101.       RETURN FALSE
  102.     END;
  103.         (* If here, test character values *)
  104.     IF (CAP(lower[i]) > CAP(upper[i])) THEN
  105.       RETURN TRUE
  106.     ELSIF (CAP(lower[i]) < CAP(upper[i])) THEN
  107.       RETURN FALSE
  108.     END;
  109.   END;
  110.   RETURN FALSE;
  111. END FirstHigher;
  112.  
  113.  
  114. PROCEDURE QSort;
  115. VAR i,j : CARDINAL; Swap : BOOLEAN;
  116. (* Sort the directory - DirEntries is top 1 is bottom   *)
  117. (* QuickSort recursive calling *)
  118.  
  119.  PROCEDURE Sort(l,r:CARDINAL);
  120.  VAR i,j:CARDINAL;
  121.      x,w:DirPtr;
  122.  BEGIN
  123.    i := l; j := r;
  124.    x := DirTable[(l + r) DIV 2];
  125.    REPEAT
  126.      WHILE FirstHigher(x^.FileName,DirTable[i]^.FileName) DO INC(i) END;
  127.      WHILE FirstHigher(DirTable[j]^.FileName,x^.FileName) DO DEC(j) END;
  128.      IF i <= j THEN
  129.        w := DirTable[i];
  130.        DirTable[i] := DirTable[j];
  131.        DirTable[j] := w;
  132.        INC(i);
  133.        DEC(j);
  134.      END;
  135.    UNTIL (i > j);
  136.    IF l < j THEN Sort(l,j) END;
  137.    IF i < r THEN Sort(i,r) END;
  138.  END Sort;
  139.  
  140. BEGIN
  141.   Sort(1,DirEntries);
  142. END QSort;
  143.  
  144. (*----------*)
  145.  
  146. PROCEDURE MoveString(VAR tgt,src:ARRAY OF CHAR; po,le:CARDINAL);
  147. (* move max of 'le' chars of src to tgt[po] *)
  148. (* not including ending null                *)
  149. VAR s:CARDINAL;
  150. BEGIN
  151.   s := 0;
  152.   WHILE (s < le) AND (src[s] <> 0C) DO;
  153.     tgt[po+s] := src[s];
  154.     INC(s);
  155.   END;
  156. END MoveString;
  157.  
  158. PROCEDURE DisplayName(file,pos:CARDINAL);
  159. VAR m,t:CARDINAL;f,b:WBColors;
  160. VAR StrNr:ARRAY[0..33] OF CHAR; Dun:BOOLEAN; GPString:ARRAY[0..38] OF CHAR;
  161. BEGIN
  162.   WITH DirTable[file]^ DO
  163.     m := Length(FileName);
  164.     IF m>28 THEN m := 28 END;
  165.     GPString := "                                   "; (*35char*)
  166.     f := Black; b := Blue;
  167.     t := (pos * 8) + 16;
  168.     IF (file>DirEntries) THEN
  169.       b := Black;
  170.     ELSIF IsDir THEN
  171.       MoveString(GPString,FileName,0,m);
  172.       IF IsSelected THEN
  173.         b:= Green
  174.       ELSE
  175.         f := Green; b:= Black;
  176.       END;
  177.     ELSE
  178.       MoveString(GPString,FileName,0,m);
  179.       ConvertToString(FileSize,10,FALSE,StrNr,Dun);
  180.       m := Length(StrNr);
  181.       MoveString(GPString,StrNr,35-m,m);
  182.       IF IsSelected THEN
  183.         f := Black; b := White
  184.       ELSE
  185.         f := White; b := Black
  186.       END;
  187.     END;
  188.     WITH FileText DO
  189.       FrontPen := BYTE(ORD(f));
  190.       BackPen := BYTE(ORD(b));
  191.       DrawMode := BYTE(JamTwo);
  192.       LeftEdge := 6;   TopEdge := t;
  193.       ITextFont := NULL;  IText := ADR(GPString);
  194.       NextText := NULL;
  195.     END;
  196.     PrintIText(DuWindowPtr^.RPort^,FileText,0,0);
  197.   END;
  198. END DisplayName;
  199.  
  200. PROCEDURE DisplayFiles(ind:CARDINAL);
  201. VAR i:CARDINAL;
  202. BEGIN
  203.   FOR i := 1 TO MaxScreenFiles DO DisplayName(i+ind-1,i) END;
  204. END DisplayFiles;
  205.  
  206. PROCEDURE NewDir;
  207. VAR Vbod : CARDINAL;
  208. (* Display a new directory *)
  209. BEGIN
  210.   Vbod := 0FFFFH;
  211.   IF DirEntries > MaxScreenFiles THEN
  212.     Vbod := 0FFFFH DIV DirEntries;
  213.     Vbod := Vbod * MaxScreenFiles;
  214.   END;
  215.   ResetSlider(Vbod);
  216.   DisplayFiles(1);
  217. END NewDir;
  218.  
  219. PROCEDURE ClearTable;
  220. VAR i:CARDINAL;
  221. BEGIN
  222.   FOR i := 0 TO MaxFiles DO
  223.     FreeMem(DirTable[i],TSIZE(DirInfo))
  224.   END;
  225. END ClearTable;
  226.  
  227. BEGIN
  228.   MaxFiles := 0;
  229.   InitStringModule;
  230.   (* Allocate memory for DirTable entries        *)
  231.   (* items will be NULL if not available          *)
  232.   (* Remember to free with ClearTable when exiting *)
  233.   REPEAT
  234.   DirTable[MaxFiles] := AllocMem(TSIZE(DirInfo),MemReqSet{MemPublic,MemClear});
  235.     INC(MaxFiles);
  236.   UNTIL (DirTable[MaxFiles-1] = NULL) OR (MaxFiles > MaxMax);
  237.   DEC(MaxFiles);
  238. END DuDir.
  239.  
  240.